home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_s.arc / ICONX.ARC / FSYS.C < prev    next >
Encoding:
C/C++ Source or Header  |  1990-03-28  |  29.1 KB  |  1,301 lines
  1. /*
  2.  * File: fsys.c
  3.  *  Contents: close, exit, getenv, open, read, reads, remove, rename, [save],
  4.  *   seek, stop, [system], where, write, writes, [getch, getche, kbhit]
  5.  */
  6.  
  7. #include "..\h\config.h"
  8. #include "..\h\rt.h"
  9. #include "rproto.h"
  10.  
  11. #if MICROSOFT || SCO_XENIX
  12. #define BadCode
  13. #endif                    /* MICROSOFT || SCO_XENIX */
  14.  
  15. #ifdef XENIX_386
  16. #define register
  17. #endif                    /* XENIX_386 */
  18.  
  19. #if MACINTOSH
  20. #if MPW
  21. #include <Files.h>
  22. #include <FCntl.h>
  23. #include <IOCtl.h>
  24. #define isatty(fd) (!ioctl((fd), FIOINTERACTIVE))
  25. #define fflush(f) 0
  26. #endif                    /* MPW */
  27. #endif                    /* MACINTOSH */
  28.  
  29. /*
  30.  * close(f) - close file f.
  31.  */
  32.  
  33. FncDcl(close,1)
  34.    {
  35.    FILE *f;
  36.  
  37.    /*
  38.     * Arg1 must be a file.
  39.     */
  40.    if (Arg1.dword != D_File) 
  41.       RunErr(105, &Arg1);
  42.  
  43.    /*
  44.     * Close Arg1, using fclose or pclose as appropriate.
  45.     */
  46.  
  47. #if UNIX || VMS
  48.    if (BlkLoc(Arg1)->file.status & Fs_Pipe) {
  49.       BlkLoc(Arg1)->file.status = 0;
  50.       MakeInt((long)((pclose(BlkLoc(Arg1)->file.fd) >> 8) & 0377), &Arg0);
  51.       Return;
  52.       }
  53.    else
  54. #endif                    /* UNIX || VMS */
  55.  
  56.       f = BlkLoc(Arg1)->file.fd;
  57.  
  58.    fclose(f);
  59.    BlkLoc(Arg1)->file.status = 0;
  60.  
  61.    /*
  62.     * Return the closed file.
  63.     */
  64.    Arg0 = Arg1;
  65.    Return;
  66.    }
  67.  
  68. /*
  69.  * exit(status) - exit process with specified status, defaults to 0.
  70.  */
  71.  
  72. FncDcl(exit,1)
  73.    {
  74.    if (defshort(&Arg1, NormalExit) == Error) 
  75.       RunErr(0, NULL);
  76.    c_exit((int)IntVal(Arg1));
  77.    }
  78.  
  79. /*
  80.  * getenv(s) - return contents of environment variable s
  81.  */
  82.  
  83. FncDcl(getenv,1)
  84.    {
  85.  
  86. #ifndef EnvVars
  87.    RunErr(-121, NULL);
  88. #else                    /* EnvVars */
  89.  
  90.    register char *p;
  91.    register word len;
  92.    char sbuf[256];
  93.  
  94.  
  95.    /*
  96.     * Make a C-style string out of Arg1
  97.     */
  98.    switch (cvstr(&Arg1, sbuf)) {
  99.  
  100.       case Cvt:   /* Already converted to a C-style string */
  101.          break;
  102.  
  103.       case NoCvt:
  104.          qtos(&Arg1, sbuf);
  105.          break;
  106.  
  107.       default:
  108.          RunErr(103, &Arg1);
  109.       }
  110.  
  111.    if ((p = getenv(StrLoc(Arg1))) != NULL) {    /* get environment variable */
  112.       len = strlen(p);
  113.       if (strreq(len) == Error) 
  114.          RunErr(0, NULL);
  115.       StrLen(Arg0) = len;
  116.       StrLoc(Arg0) = alcstr(p, len);
  117.       Return;
  118.       }
  119.    else                 /* fail if not in environment */
  120.       Fail;
  121. #endif                    /* EnvVars */
  122.    }
  123.  
  124. /*
  125.  * open(s1,s2,s3) - open file s1 with mode s2 and attributes s3.
  126.  */
  127. FncDcl(open,3)
  128.    {
  129.    register word slen;
  130.    register int i;
  131.    register char *s;
  132.    int status;
  133.    char mode[4];
  134.    extern FILE *fopen();
  135.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  136.    char *openstring;
  137.    FILE *f;
  138.  
  139. #ifdef OpenAttributes
  140.    char sbuf3[MaxCvtLen];
  141.    char *attrstring;
  142. #endif                    /* OpenAttributes */
  143.  
  144. /*
  145.  * The following code is operating-system dependent [@fsys.01].  Make
  146.  *  declarations as needed for opening files.
  147.  */
  148.  
  149. #if PORT
  150. Deliberate Syntax Error
  151. #endif                                  /* PORT */
  152.  
  153. #if AMIGA || MACINTOSH
  154.    /* nothing is needed */
  155. #endif                                  /* AMIGA || MACINTOSH */
  156.  
  157. #if ATARI_ST || HIGHC_386 || MSDOS || OS2
  158.    char untranslated;
  159. #endif                                  /* ATARI_ST || HIGHC_386 ... */
  160.  
  161. #if MACINTOSH
  162. #if LSC
  163.    char untranslated;
  164. #endif                    /* LSC */
  165. #endif                    /* MACINTOSH */
  166.  
  167. #if MVS || VM
  168.    char untranslated;
  169. #if SASC
  170. #include <lcio.h>
  171. #endif                    /* SASC */
  172. #endif                                  /* MVS || VM */
  173.  
  174. #if UNIX || VMS
  175.    extern FILE *popen();
  176. #endif                                  /* MACINTOSH || UNIX || VMS */
  177.  
  178. /*
  179.  * End of operating-system specific code.
  180.  */
  181.  
  182.  
  183.    /*
  184.     * Arg1 must be a string and a C string copy of it is also needed.
  185.     *  Make it a string if it is not one; make a C string if Arg1 is
  186.     *  a string.
  187.     */
  188.    switch (cvstr(&Arg1, sbuf1)) {
  189.  
  190.       case Cvt:
  191.          openstring = StrLoc(Arg1);
  192.          if (strreq(StrLen(Arg1)) == Error)
  193.             RunErr(0, NULL);
  194.          StrLoc(Arg1) = alcstr(StrLoc(Arg1), StrLen(Arg1));
  195.          break;
  196.  
  197.       case NoCvt:
  198.          tended[1] = Arg1;
  199.          ntended = 1;
  200.          qtos(&tended[1], sbuf1);
  201.          openstring = StrLoc(tended[1]);
  202.          break;
  203.  
  204.       default:
  205.          RunErr(103, &Arg1);
  206.       }
  207.    /*
  208.     * s2 defaults to "r".
  209.     */
  210.    if (defstr(&Arg2, sbuf2, &letr) == Error)
  211.       RunErr(0, NULL);
  212.  
  213. #ifdef OpenAttributes
  214.    /*
  215.     * Convert s3 to a string, defaulting to "".
  216.     */
  217.    ntended++;
  218.    tended[ntended] = Arg3;
  219.    if (ChkNull(tended[ntended]))
  220.       tended[ntended] = emptystr;
  221.    switch (cvstr(&tended[ntended], sbuf3)) {
  222.  
  223.       case Cvt:
  224.          attrstring = StrLoc(Arg3);
  225.          if (strreq(StrLen(Arg3)) == Error)
  226.             RunErr(0, NULL);
  227.          StrLoc(Arg3) = alcstr(StrLoc(Arg3), StrLen(Arg3));
  228.          break;
  229.  
  230.       case NoCvt:
  231.          qtos(&tended[ntended], sbuf3);
  232.          attrstring = StrLoc(tended[ntended]);
  233.          break;
  234.  
  235.       default:
  236.          RunErr(103, &Arg3);
  237.       }
  238. #endif                                  /* OpenAttributes */
  239.  
  240.    if (blkreq((word)sizeof(struct b_file)) == Error)
  241.       RunErr(0, NULL);
  242.    status = 0;
  243.  
  244. /*
  245.  * The following code is operating-system dependent [@fsys.02].  Provide
  246.  *  declaration for untranslated line-termination mode, if supported.
  247.  */
  248.  
  249. #if PORT
  250.    /* nothing to do */
  251. Deliberate Syntax Error
  252. #endif                                  /* PORT */
  253.  
  254. #if AMIGA
  255.    /* translated mode could be supported, but is not now */
  256. #endif                                  /* AMIGA */
  257.  
  258. #if ATARI_ST || HIGHC_386 || MSDOS || MVS || OS2 || VM
  259.    untranslated = 0;
  260. #endif                                  /* ATARI_ST || HIGHC_386 ... */
  261.  
  262. #if MACINTOSH
  263. #if LSC
  264.    untranslated = 0;
  265. #endif                    /* LSC */
  266. #endif                    /* MACINTOSH */
  267.  
  268. #if UNIX || VMS
  269.    /* nothing to do */
  270. #endif                                  /* UNIX || VMS */
  271.  
  272. /*
  273.  * End of operating-system specific code.
  274.  */
  275.  
  276.    /*
  277.     * Scan Arg2, setting appropriate bits in status.  Produce a run-time error
  278.     *  if an unknown character is encountered.
  279.     */
  280.    s = StrLoc(Arg2);
  281.    slen = StrLen(Arg2);
  282.    for (i = 0; i < slen; i++) {
  283.       switch (*s++) {
  284.          case 'a':
  285.          case 'A':
  286.             status |= Fs_Write|Fs_Append;
  287.             continue;
  288.          case 'b':
  289.          case 'B':
  290.             status |= Fs_Read|Fs_Write;
  291.             continue;
  292.          case 'c':
  293.          case 'C':
  294.             status |= Fs_Create|Fs_Write;
  295.             continue;
  296.          case 'r':
  297.          case 'R':
  298.             status |= Fs_Read;
  299.             continue;
  300.          case 'w':
  301.          case 'W':
  302.             status |= Fs_Write;
  303.             continue;
  304.  
  305. /*
  306.  * The following code is operating-system dependent [@fsys.03].  Handle
  307.  * untranslated line-terminator mode and pipes, if supported.
  308.  */
  309.  
  310. #if PORT
  311.          case 't':
  312.          case 'T':
  313.          case 'u':
  314.          case 'U':
  315.             continue;            /* no-op */
  316. Deliberate Syntax Error
  317. #endif                    /* PORT */
  318.  
  319. #if AMIGA 
  320.          case 't':
  321.          case 'T':
  322.          case 'u':
  323.          case 'U':
  324.             continue;            /* no-op */
  325. #endif                    /* AMIGA */
  326.  
  327. #if ATARI_ST || HIGHC_386 || MSDOS || OS2 || SASC
  328.          case 't':
  329.          case 'T':
  330.             untranslated = 0;
  331.  
  332. #ifdef RecordIO
  333.             status &= ~Fs_Record;
  334. #endif                    /* RecordIO */
  335.  
  336.             continue;
  337.          case 'u':
  338.          case 'U':
  339.             untranslated = 1;
  340.  
  341. #ifdef RecordIO
  342.             status &= ~Fs_Record;
  343. #endif                    /* RecordIO */
  344.  
  345.             continue;
  346. #endif                    /* ATARI_ST || HIGHC_386 || ... */
  347.  
  348. #ifdef RecordIO
  349.          case 's':
  350.          case 'S':
  351.             untranslated = 1;
  352.             status |= Fs_Record;
  353.             continue;
  354. #endif                                  /* RecordIO */
  355.  
  356. #if MACINTOSH
  357. #if LSC
  358.          case 't':
  359.          case 'T':
  360.             untranslated = 0;
  361.             continue;
  362.          case 'u':
  363.          case 'U':
  364.             untranslated = 1;
  365.             continue;
  366. #endif                    /* LSC */
  367. #endif                    /* MACINTOSH */
  368.  
  369. #if UNIX || VMS
  370.          case 't':
  371.          case 'T':
  372.          case 'u':
  373.          case 'U':
  374.             continue;            /* no-op */
  375.          case 'p':
  376.          case 'P':
  377.             status |= Fs_Pipe;
  378.             continue;
  379. #endif                    /* UNIX || VMS */
  380.  
  381. /*
  382.  * End of operating-system specific code.
  383.  */
  384.  
  385.          default:
  386.             RunErr(209, &Arg2);
  387.          }
  388.       }
  389.  
  390.    /*
  391.     * Construct a mode field for fopen/popen.
  392.     */
  393.    mode[0] = '\0';
  394.    mode[1] = '\0';
  395.    mode[2] = '\0';
  396.    mode[3] = '\0';
  397.  
  398.    if ((status & (Fs_Read|Fs_Write)) == 0)   /* default: read only */
  399.       status |= Fs_Read;
  400.    if (status & Fs_Create)
  401.       mode[0] = 'w';
  402.    else if (status & Fs_Append)
  403.       mode[0] = 'a';
  404.    else if (status & Fs_Read)
  405.       mode[0] = 'r';
  406.    else
  407.       mode[0] = 'w';
  408.  
  409. /*
  410.  * The following code is operating-system dependent [@fsys.04].  Handle open
  411.  *  modes.
  412.  */
  413.  
  414. #if PORT
  415.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  416.       mode[1] = '+';
  417. Deliberate Syntax Error
  418. #endif                                  /* PORT */
  419.  
  420. #if AMIGA || UNIX || VMS
  421.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  422.       mode[1] = '+';
  423. #endif                                  /* AMIGA || UNIX || VMS */
  424.  
  425. #if ATARI_ST
  426.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  427.       mode[1] = '+';
  428.       mode[2] = untranslated ? 'b' : 'a';
  429.       }
  430.    else mode[1] = untranslated ? 'b' : 'a';
  431. #endif                                  /* ATARI_ST */
  432.  
  433. #if HIGHC_386 || OS2
  434.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  435.       mode[1] = '+';
  436.       mode[2] = untranslated ? 'b' : 't';
  437.       }
  438.    else mode[1] = untranslated ? 'b' : 't';
  439. #endif                                  /* HIGHC_386 || OS2 */
  440.  
  441. #if MACINTOSH
  442. #if LSC
  443.    untranslated = 0;
  444. #endif                    /* LSC */
  445. #endif                    /* MACINTOSH */
  446.  
  447. #if MVS || VM
  448.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  449.       mode[1] = '+';
  450.       mode[2] = untranslated ? 'b' : 0;
  451.       }
  452.    else mode[1] = untranslated ? 'b' : 0;
  453. #endif                                  /* MVS || VM */
  454.  
  455. /*
  456.  * End of operating-system specific code.
  457.  */
  458.  
  459.    /*
  460.     * Open the file with fopen or popen.
  461.     */
  462.  
  463. #ifdef OpenAttributes
  464. #if SASC
  465. #ifdef RecordIO
  466.       f = afopen(openstring, mode, status & Fs_Record ? "seq" : "",
  467.                  attrstring);
  468. #else                    /* RecordIO */
  469.       f = afopen(openstring, mode, "", attrstring);
  470. #endif                                  /* RecordIO */
  471. #endif                                  /* SASC */
  472.  
  473. #else                                   /* OpenAttributes */
  474.  
  475. #if UNIX || VMS
  476.    if (status & Fs_Pipe) {
  477.       if (status != (Fs_Read|Fs_Pipe) && status != (Fs_Write|Fs_Pipe))
  478.          RunErr(209, &Arg2);
  479.       f = popen(openstring, mode);
  480.       }
  481.    else
  482. #endif                                  /* UNIX || VMS */
  483.  
  484.       f = fopen(openstring, mode);
  485. #endif                                  /* OpenAttributes */
  486.  
  487.    /*
  488.     * Fail if the file cannot be opened.
  489.     */
  490.    if (f == NULL)
  491.       Fail;
  492.  
  493.    /*
  494.     * Return the resulting file value.
  495.     */
  496.    Arg0.dword = D_File;
  497.    BlkLoc(Arg0) = (union block *) alcfile(f, status, &Arg1);
  498.    ntended = 0;
  499.    Return;
  500.    }
  501.  
  502. /*
  503.  * read(f) - read line on file f.
  504.  */
  505. FncDcl(read,1)
  506.    {
  507.    register word slen, rlen;
  508.    register char *sp;
  509.    int status;
  510.    static char sbuf[MaxReadStr];
  511.    FILE *f;
  512.  
  513.    /*
  514.     * Default Arg1 to &input.
  515.     */
  516.    if (deffile(&Arg1, &input) == Error) 
  517.       RunErr(0, NULL);
  518.  
  519.    /*
  520.     * Get a pointer to the file and be sure that it is open for reading.
  521.     */
  522.    f = BlkLoc(Arg1)->file.fd;
  523.    status = (int)BlkLoc(Arg1)->file.status;
  524.    if ((status & Fs_Read) == 0) 
  525.       RunErr(212, &Arg1);
  526.  
  527. #ifdef StandardLib
  528.    if (status & Fs_Writing) {
  529.       fseek(f, 0L, SEEK_CUR);
  530.       BlkLoc(Arg1)->file.status &= ~Fs_Writing;
  531.       }
  532.    BlkLoc(Arg1)->file.status |= Fs_Reading;
  533. #endif                    /* StandardLib */
  534.  
  535.    /*
  536.     * Use getstrg to read a line from the file, failing if getstrg
  537.     *  encounters end of file. [[ What about -2?]]
  538.     */
  539.    StrLen(Arg0) = 0;
  540.    do {
  541.  
  542. #ifdef RecordIO
  543.       if ((slen = (status & Fs_Record ? getrec(sbuf, MaxReadStr, f) :
  544.                                         getstrg(sbuf, MaxReadStr, f)))
  545.           == -1) Fail;
  546. #else                    /* RecordIO */
  547.       if ((slen = getstrg(sbuf,MaxReadStr,f)) == -1)
  548.          Fail;
  549. #endif                                  /* RecordIO */
  550.  
  551.       /*
  552.        * Allocate the string read and make Arg0 a descriptor for it.
  553.        */
  554.       rlen = slen < 0 ? (word)MaxReadStr : slen;
  555.       if (strreq(rlen) == Error) 
  556.          RunErr(0, NULL);
  557.       sp = alcstr(sbuf,rlen);
  558.       if (StrLen(Arg0) == 0)
  559.          StrLoc(Arg0) = sp;
  560.       StrLen(Arg0) += rlen;
  561.       } while (slen < 0);
  562.    Return;
  563.    }
  564.  
  565. /*
  566.  * reads(f,i) - read i characters on file f.
  567.  */
  568. FncDcl(reads,2)
  569.    {
  570.    register word cnt;
  571.    long tally;
  572.    int status;
  573.    FILE *f;
  574.  
  575.    /*
  576.     * Arg1 defaults to &input and Arg2 defaults to 1 (character).
  577.     */
  578.    if ((deffile(&Arg1, &input) == Error) ||
  579.        (defshort(&Arg2, 1) == Error)) 
  580.       RunErr(0, NULL);
  581.  
  582.    /*
  583.     * Get a pointer to the file and be sure that it is open for reading.
  584.     */
  585.    f = BlkLoc(Arg1)->file.fd;
  586.    status = (int)BlkLoc(Arg1)->file.status;
  587.    if ((status & Fs_Read) == 0) 
  588.       RunErr(212, &Arg1);
  589.  
  590. #ifdef StandardLib
  591.    if (status & Fs_Writing) {
  592.       fseek(f, 0L, SEEK_CUR);
  593.       BlkLoc(Arg1)->file.status &= ~Fs_Writing;
  594.       }
  595.    BlkLoc(Arg1)->file.status |= Fs_Reading;
  596. #endif                    /* StandardLib */
  597.  
  598.    /*
  599.     * Be sure that a positive number of bytes is to be read.
  600.     */
  601.    if ((cnt = IntVal(Arg2)) <= 0) 
  602.       RunErr(205, &Arg2);
  603.  
  604.    /*
  605.     * Ensure that enough space for the string exists and read it directly
  606.     *  into the string space.  (By reading directly into the string space,
  607.     *  no arbitrary restrictions are placed on the size of the string that
  608.     *  can be read.)  Make Arg0 a descriptor for the string and return it.
  609.     */
  610.    if (strreq(cnt) == Error) 
  611.       RunErr(0, NULL);
  612.    if (strfree + cnt > strend)
  613.       syserr("reads allocation botch");
  614.    StrLoc(Arg0) = strfree;
  615.  
  616. #if AMIGA
  617.    /*
  618.     * The following code is special for Lattice 4.0 -- it was different
  619.     *  for Lattice 3.10.  It probably won't work correctly with other
  620.     *  C compilers.
  621.     */
  622.    if (IsInteractive(_ufbs[fileno(f)].ufbfh)) {
  623.       if ((cnt = read(fileno(f),StrLoc(Arg0),cnt)) <= 0)
  624.          Fail;
  625.       StrLen(Arg0) = cnt;
  626.       alcstr(NULL, cnt);
  627.       Return;
  628.       }
  629. #endif                    /* AMIGA */
  630.  
  631.    tally = longread(StrLoc(Arg0),sizeof(char),cnt,f);
  632.    if (tally == 0)
  633.       Fail;
  634.    StrLen(Arg0) = tally;
  635.    alcstr(NULL, (word)tally);
  636.    Return;
  637.    }
  638.  
  639. /*
  640.  * remove(s) - remove the file named s.
  641.  */
  642.  
  643. FncDcl(remove,1)
  644.    {
  645.    char sbuf[MaxCvtLen];
  646.  
  647.    /*
  648.     * Make a C-style string out of Arg1
  649.     */
  650.    switch (cvstr(&Arg1, sbuf)) {
  651.  
  652.       case Cvt:   /* Already converted to a C-style string */
  653.          break;
  654.  
  655.       case NoCvt:
  656.          qtos(&Arg1, sbuf);
  657.          break;
  658.  
  659.       default:
  660.          RunErr(103, &Arg1);
  661.       }
  662.    if (unlink(StrLoc(Arg1)) != 0)
  663.       Fail;
  664.    Arg0 = nulldesc;
  665.    Return;
  666.    }
  667.  
  668. /*
  669.  * rename(s1,s2) - rename the file named s1 to have the name s2.
  670.  */
  671.  
  672. FncDcl(rename,2)
  673.    {
  674.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  675.  
  676.    /*
  677.     * Make a C-style string out of Arg1
  678.     */
  679.    switch (cvstr(&Arg1, sbuf1)) {
  680.  
  681.       case Cvt:   /* Already converted to a C-style string */
  682.          break;
  683.  
  684.       case NoCvt:
  685.          qtos(&Arg1, sbuf1);
  686.          break;
  687.  
  688.       default:
  689.          RunErr(103, &Arg1);
  690.       }
  691.  
  692.    /*
  693.     * Make a C-style string out of Arg2
  694.     */
  695.    switch (cvstr(&Arg2, sbuf2)) {
  696.  
  697.       case Cvt:   /* Already converted to a C-style string */
  698.          break;
  699.  
  700.       case NoCvt:
  701.          qtos(&Arg2, sbuf2);
  702.          break;
  703.  
  704.       default:
  705.          RunErr(103, &Arg2);
  706.       }
  707.  
  708. /*
  709.  * The following code is operating-system dependent [@fsys.05].  Rename the
  710.  *  file, and fail if unsuccessful.
  711.  */
  712.  
  713. #if PORT
  714.    /* need something */
  715. Deliberate Syntax Error
  716. #endif                    /* PORT */
  717.  
  718. #if AMIGA || ATARI_ST || HIGHC_386 || MACINTOSH || MSDOS || MVS || OS2 || VM || VMS
  719.    {
  720.    if (rename(StrLoc(Arg1),StrLoc(Arg2)) != 0)
  721.       Fail;
  722.    }
  723. #endif                    /* AMIGA || ATARI_ST ... */
  724.  
  725. #if UNIX
  726.    if (link(StrLoc(Arg1),StrLoc(Arg2)) != 0)
  727.       Fail;
  728.    if (unlink(StrLoc(Arg1)) != 0) {
  729.       unlink(StrLoc(Arg2));    /* try to undo partial rename */
  730.       Fail;
  731.       }
  732. #endif                    /* UNIX */
  733.  
  734. /*
  735.  * End of operating-system specific code.
  736.  */
  737.  
  738.    Arg0 = nulldesc;
  739.    Return;
  740.    }
  741.  
  742. #ifdef ExecImages
  743. /*
  744.  * save(s) - save the run-time system in file s
  745.  */
  746.  
  747. FncDcl(save,1)
  748.    {
  749.    char sbuf[MaxCvtLen];
  750.    int f, fsz;
  751.  
  752.    dumped = 1;
  753.  
  754.    /* if (ChkNull(Arg1)) { abort(); } */
  755.  
  756.    /*
  757.     * Make a C-style string out of Arg1.
  758.     */
  759.    switch (cvstr(&Arg1, sbuf)) {
  760.  
  761.       case Cvt:   /* Already converted to a C-style string */
  762.          break;
  763.  
  764.       case NoCvt:
  765.          qtos(&Arg1, sbuf);
  766.          break;
  767.  
  768.       default:
  769.          RunErr(103, &Arg1);
  770.       }
  771.  
  772.  
  773.    /*
  774.     * Open the file for the executable image.
  775.     */
  776.    f = creat(StrLoc(Arg1), 0777);
  777.    if (f == -1)
  778.       Fail;
  779.    fsz = wrtexec(f);
  780.    /*
  781.     * It happens that most wrtexecs don't check the system call return
  782.     *  codes and thus they'll never return -1.  Nonetheless...
  783.     */
  784.    if (fsz == -1)
  785.       Fail;
  786.    /*
  787.     * Return the size of the data space.
  788.     */
  789.    MakeInt(fsz, &Arg0);
  790.    Return;
  791.    }
  792.  
  793. #endif                    /* ExecImages */
  794.  
  795. /*
  796.  * seek(file,position) - seek to byte byte position in file.
  797.  */
  798.  
  799. FncDcl(seek,2)
  800.    {
  801.    long l1;
  802.    FILE *fd;
  803.  
  804.    if (Arg1.dword != D_File) 
  805.       RunErr(-105, NULL);
  806.  
  807.    if (defint(&Arg2, &l1, 1L) == Error)
  808.       RunErr(0, NULL);
  809.  
  810.    fd = BlkLoc(Arg1)->file.fd;
  811.  
  812.    if (BlkLoc(Arg1)->file.status == 0)
  813.       Fail;
  814.     if (l1 > 0) {
  815.  
  816. #ifdef StandardLib
  817.        if (fseek(fd, l1 - 1, SEEK_SET) == -1)
  818. #else                    /* StandardLib */
  819.        if (fseek(fd, l1 - 1, 0) == -1)
  820. #endif                    /* StandardLib */
  821.  
  822.           Fail;
  823.        }
  824.     else {
  825.  
  826. #ifdef StandardLib
  827.        if (fseek(fd, l1, SEEK_END) == -1)
  828. #else                    /* StandardLib */
  829.        if (fseek(fd, l1, 2) == -1)
  830. #endif                    /* StandardLib */
  831.           Fail;
  832.        }
  833.  
  834. #ifdef StandardLib
  835.     BlkLoc(Arg1)->file.status &= ~(Fs_Reading | Fs_Writing);
  836. #endif                    /* StandardLib */
  837.  
  838.    Arg0 = Arg1;
  839.    Return;
  840.    }
  841.  
  842. /*
  843.  * stop(a,b,...) - write arguments (starting on error output) and stop.
  844.  */
  845.  
  846. FncDclV(stop)
  847.     {
  848.    register word n;
  849.    char sbuf[MaxCvtLen];
  850.    FILE *f;
  851.  
  852. #ifdef BadCode
  853.    struct descrip temp;
  854. #endif                    /* BadCode */
  855.  
  856.    f = stderr;
  857.    ntended = 1;
  858.    /*
  859.     * Loop through arguments.
  860.     */
  861.  
  862.    for (n = 1; n <= nargs; n++) {
  863.  
  864. #ifdef BadCode 
  865.       temp = Arg(n);            /* workaround for Microsoft C bug */
  866.       tended[1] = temp;
  867. #else                    /* BadCode */
  868.       tended[1] = Arg(n);
  869. #endif                    /* BadCode */
  870.  
  871.       if (tended[1].dword == D_File) {
  872.          if (n > 1)
  873.             putc('\n', f);
  874.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  875.             RunErr(213, &tended[1]);
  876.          f = BlkLoc(tended[1])->file.fd;
  877.  
  878. #ifdef StandardLib
  879.          if (BlkLoc(tended[1])->file.status & Fs_Reading) {
  880.             fseek(f, 0L, SEEK_CUR);
  881.             BlkLoc(tended[1])->file.status &= ~Fs_Reading;
  882.             }
  883.          BlkLoc(tended[1])->file.status |= Fs_Writing;
  884. #endif                    /* StandardLib */
  885.          }
  886.       else {
  887.  
  888.          if (n == 1 && (k_output.status & Fs_Write) == 0)
  889.             RunErr(-213, NULL);
  890.  
  891. #ifdef StandardLib
  892.          if (n == 1) {
  893.             if (k_output.status & Fs_Reading) {
  894.                fseek(f, 0L, SEEK_CUR);
  895.                k_output.status &= ~Fs_Reading;
  896.                }
  897.             k_output.status |= Fs_Writing;
  898.          }
  899. #endif                    /* StandardLib */
  900.  
  901.          if (ChkNull(tended[1]))
  902.             tended[1] = emptystr;
  903.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  904.             RunErr(109, &tended[1]);
  905.          putstr(f, &tended[1]);
  906.          }
  907.       }
  908.  
  909.    putc('\n', f);
  910.    fflush(f);
  911.    c_exit(ErrorExit);
  912.    }
  913.  
  914. #ifdef SystemFnc
  915. /*
  916.  * system(s) - execute string s as a system command.
  917.  */
  918.  
  919. FncDcl(system,1)
  920.    {
  921.    char sbuf[MaxCvtLen];
  922.    char *systemstring;
  923.  
  924.    /*
  925.     * Make a C-style string out of Arg1
  926.     */
  927.    switch (cvstr(&Arg1, sbuf)) {
  928.  
  929.       case Cvt:   /* Already converted to a C-style string */
  930.          break;
  931.  
  932.       case NoCvt:
  933.          qtos(&Arg1, sbuf);
  934.          break;
  935.  
  936.       default:
  937.          RunErr(103, &Arg1);
  938.       }
  939.       systemstring = StrLoc(Arg1);
  940.  
  941.    /*
  942.     * Pass the C string to the system() function and return the exit code
  943.     *  of the command as the result of system().
  944.     */
  945.  
  946. /*
  947.  * The following code is operating-system dependent [@fsys.06].  Perform system
  948.  *  call.  Should not get here unless system(s) is supported.
  949.  */
  950.  
  951. #if PORT
  952. Deliberate Syntax Error
  953. #endif                    /* PORT */
  954.  
  955. #if AMIGA || MSDOS || OS2 || UNIX
  956.    MakeInt((long)((system(systemstring) >> 8) & 0377), &Arg0);
  957. #endif                    /* AMIGA || MSDOS || ... */
  958.  
  959. #if ATARI_ST || VMS
  960.    MakeInt(system(systemstring), &Arg0);
  961. #endif                    /* ATARI_ST || VMS */
  962.  
  963. #if HIGHC_386 || MACINTOSH
  964.    /* Should not get here */
  965. #endif                    /* HIGHC_386 */
  966.  
  967. #if MVS || VM
  968. #if SASC && MVS
  969.    {
  970.       char *wprefix;
  971.       wprefix = malloc(strlen(systemstring)+5);
  972.                      /* hope this will do no harm... */
  973.       sprintf(wprefix,"tso:%s",systemstring);
  974.       MakeInt((long)system(wprefix), &Arg0);
  975.       free(wprefix);
  976.    }
  977. #else                    /* SASC && MVS */
  978.    MakeInt((long)system(systemstring), &Arg0);
  979. #endif                    /* SASC && MVS */
  980. #endif                                  /* MVS || VM */
  981.  
  982. /*
  983.  * End of operating-system specific code.
  984.  */
  985.    Return;
  986.    }
  987.  
  988. #endif                    /* SystemFnc */
  989. /*
  990.  * where(file) - return current offset position in file.
  991.  */
  992.  
  993. FncDcl(where,1)
  994.    {
  995.    FILE *fd;
  996.    long ftell();
  997.    long pos;
  998.  
  999.    if (Arg1.dword != D_File) 
  1000.       RunErr(-105, NULL);
  1001.  
  1002.    fd = BlkLoc(Arg1)->file.fd;
  1003.  
  1004.    if ((BlkLoc(Arg1)->file.status == 0))
  1005.       Fail;
  1006.  
  1007. #ifdef StandardLib
  1008.    MakeInt(pos = ftell(fd) + 1, &Arg0);
  1009.    if (pos == 0)
  1010.       Fail;  /* may only be effective on ANSI systems */
  1011. #else                    /* StandardLib */
  1012.    MakeInt(ftell(fd) + 1, &Arg0);
  1013. #endif                    /* StandardLib */
  1014.  
  1015.    Return;
  1016.    }
  1017.  
  1018. /*
  1019.  * write(a,b,...) - write arguments.
  1020.  */
  1021. FncDclV(write)
  1022.    {
  1023.    register word n;
  1024.    char sbuf[MaxCvtLen];
  1025.    FILE *f;
  1026.  
  1027. #ifdef RecordIO
  1028.    word status = k_output.status;
  1029. #endif                    /* RecordIO */
  1030.  
  1031. #ifdef BadCode
  1032.    struct descrip temp;
  1033. #endif                    /* BadCode */
  1034.  
  1035.    f = stdout;
  1036.    ntended = 1;
  1037.    tended[1] = emptystr;
  1038.  
  1039.    /*
  1040.     * Loop through the arguments.
  1041.     */
  1042.    for (n = 1; n <= nargs; n++) {
  1043.  
  1044. #ifdef BadCode
  1045.       temp = Arg(n);            /* workaround for Microsoft bug */
  1046.       tended[1] = temp;
  1047. #else                    /* BadCode */
  1048.       tended[1] = Arg(n);
  1049. #endif                    /* BadCode */
  1050.  
  1051.       if (tended[1].dword == D_File)    {    /* Current argument is a file */
  1052.          /*
  1053.           * If this is not the first argument, output a newline to the current
  1054.           *  file and flush it.
  1055.           */
  1056.          if (n > 1) {
  1057.  
  1058. #ifdef RecordIO
  1059.             if (status & Fs_Record)
  1060.                flushrec(f);
  1061.             else
  1062. #endif                    /* RecordIO */
  1063.  
  1064.             putc('\n', f);
  1065.             fflush(f);
  1066.             }
  1067.          /*
  1068.           * Switch the current file to the file named by the current argument
  1069.           *  providing it is a file.  tended[1] is made to be a empty string to
  1070.           *  avoid a special case.
  1071.           */
  1072.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  1073.             RunErr(213, &tended[1]);
  1074.          f = BlkLoc(tended[1])->file.fd;
  1075.  
  1076. #ifdef StandardLib
  1077.          if (BlkLoc(tended[1])->file.status & Fs_Reading) {
  1078.             fseek(f, 0L, SEEK_CUR);
  1079.             BlkLoc(tended[1])->file.status &= ~Fs_Reading;
  1080.             }
  1081.          BlkLoc(tended[1])->file.status |= Fs_Writing;
  1082. #endif                    /* StandardLib */
  1083.  
  1084. #ifdef RecordIO
  1085.          status = BlkLoc(tended[1])->file.status;
  1086. #endif                    /* RecordIO */
  1087.  
  1088.          tended[1] = emptystr;
  1089.          }
  1090.       else {    /* Current argument is a string */
  1091.          /*
  1092.           * On first argument, check to be sure that &output is open
  1093.           *  for output.
  1094.           */
  1095.          if (n == 1 && (k_output.status & Fs_Write) == 0)
  1096.             RunErr(-213, NULL);
  1097.  
  1098. #ifdef StandardLib
  1099.          if (n == 1) {
  1100.             if (k_output.status & Fs_Reading) {
  1101.                fseek(f, 0L, SEEK_CUR);
  1102.                k_output.status &= ~Fs_Reading;
  1103.                }
  1104.             k_output.status |= Fs_Writing;
  1105.          }
  1106. #endif                    /* StandardLib */
  1107.  
  1108.          /*
  1109.           * Convert the argument to a string, defaulting to a empty string.
  1110.           */
  1111.          if (ChkNull(tended[1]))
  1112.             tended[1] = emptystr;
  1113.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  1114.             RunErr(109, &tended[1]);
  1115.  
  1116.          /*
  1117.           * Output the string.
  1118.           */
  1119.  
  1120. #ifdef RecordIO
  1121.          if ((status & Fs_Record ? putrec(f, &tended[1]) :
  1122.                                    putstr(f, &tended[1])) == Failure)
  1123. #else                    /* RecordIO */
  1124.          if (putstr(f, &tended[1]) == Failure)
  1125. #endif                    /* RecordIO */
  1126.             RunErr(-214, NULL);
  1127.          }
  1128.       }
  1129.    /*
  1130.     * Append a newline to the file and flush it.
  1131.     */
  1132.  
  1133. #ifdef RecordIO
  1134.    if (status & Fs_Record)
  1135.       flushrec(f);
  1136.    else
  1137. #endif                    /* RecordIO */
  1138.  
  1139.    putc('\n', f);
  1140.    if (ferror(f))
  1141.       RunErr(-214, NULL);
  1142.  
  1143.    fflush(f);
  1144.  
  1145.    /*
  1146.     * Return the last argument.
  1147.     */
  1148.    ntended = 0;
  1149.    Arg(0) = Arg(n - 1);
  1150.    Return;
  1151.    }
  1152.  
  1153. /*
  1154.  * writes(a,b,...) - write arguments without newline terminator.
  1155.  */
  1156.  
  1157. FncDclV(writes)
  1158.    {
  1159.    register word n;
  1160.    char sbuf[MaxCvtLen];
  1161.    FILE *f;
  1162.  
  1163. #ifdef BadCode
  1164.    struct descrip temp;
  1165. #endif                    /* BadCode */
  1166.  
  1167.    f = stdout;
  1168.    ntended = 1;
  1169.    tended[1] = emptystr;
  1170.  
  1171.    /*
  1172.     * Loop through the arguments.
  1173.     */
  1174.    for (n = 1; n <= nargs; n++) {
  1175.  
  1176. #ifdef BadCode
  1177.       temp = Arg(n);            /* workaround for Microsoft bug */
  1178.       tended[1] = temp;
  1179. #else                    /* BadCode */
  1180.       tended[1] = Arg(n);
  1181. #endif                    /* BadCode */
  1182.  
  1183.       if (tended[1].dword == D_File)    {    /* Current argument is a file */
  1184.          /*
  1185.           * Switch the current file to the file named by the current argument
  1186.           *  providing it is a file.  tended[1] is made to be a empty string to
  1187.           *  avoid a special case.
  1188.           */
  1189.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  1190.             RunErr(213, &tended[1]);
  1191.          f = BlkLoc(tended[1])->file.fd;
  1192.  
  1193. #ifdef StandardLib
  1194.          if (BlkLoc(tended[1])->file.status & Fs_Reading) {
  1195.             fseek(f, 0L, SEEK_CUR);
  1196.             BlkLoc(tended[1])->file.status &= ~Fs_Reading;
  1197.             }
  1198.          BlkLoc(tended[1])->file.status |= Fs_Writing;
  1199. #endif                    /* StandardLib */
  1200.  
  1201.          tended[1] = emptystr;
  1202.          }
  1203.       else {    /* Current argument is a string */
  1204.          /*
  1205.           * On first argument, check to be sure that &output is open
  1206.           *  for output.
  1207.           */
  1208.          if (n == 1 && (k_output.status & Fs_Write) == 0) 
  1209.             RunErr(-213, NULL);
  1210.  
  1211. #ifdef StandardLib
  1212.          if (n == 1) {
  1213.             if (k_output.status & Fs_Reading) {
  1214.                fseek(f, 0L, SEEK_CUR);
  1215.                k_output.status &= ~Fs_Reading;
  1216.                }
  1217.             k_output.status |= Fs_Writing;
  1218.          }
  1219. #endif                    /* StandardLib */
  1220.  
  1221.          /*
  1222.           * Convert the argument to a string, defaulting to a empty string.
  1223.           */
  1224.          if (ChkNull(tended[1]))
  1225.             tended[1] = emptystr;
  1226.          if (cvstr(&tended[1], sbuf) == CvtFail)
  1227.             RunErr(109, &tended[1]);
  1228.          /*
  1229.           * Output the string and flush the file.
  1230.           */
  1231.          if (putstr(f, &tended[1]) == Failure)
  1232.             RunErr(-214, NULL);
  1233.  
  1234. #if !MVS && !VM         /* forces record break on the 370! */
  1235.          fflush(f);
  1236. #endif                    /* !MVS && !VM */
  1237.  
  1238.          }
  1239.       }
  1240.    /*
  1241.     * Return the last argument.
  1242.     */
  1243.    ntended = 0;
  1244.    Arg(0) = Arg(n - 1);
  1245.    Return;
  1246.    }
  1247.  
  1248. #ifdef KeyboardFncs
  1249. /*
  1250.  * getch() - return a character from console.
  1251.  */
  1252.  
  1253. FncDcl(getch,0)
  1254.    {
  1255.    unsigned char c;
  1256.    int i;
  1257.    i = getch();
  1258.    if (i<0)
  1259.       Fail;
  1260.    if (strreq((word)1) == Error)
  1261.       RunErr(0, NULL);
  1262.    c = (unsigned char) i;
  1263.    StrLoc(Arg0) = alcstr((char *)&c,(word)1);
  1264.    StrLen(Arg0) = 1;
  1265.    Return;
  1266.    }
  1267.  
  1268. /*
  1269.  * getche() -- return a character from console with echo.
  1270.  */
  1271.  
  1272. FncDcl(getche,0)
  1273.    {
  1274.    unsigned char c;
  1275.    int i;
  1276.    i = getche();
  1277.    if (i<0)
  1278.       Fail;
  1279.    if (strreq((word)1) == Error)
  1280.       RunErr(0, NULL);
  1281.    c = (unsigned char) i;
  1282.    StrLoc(Arg0) = alcstr((char *)&c,(word)1);
  1283.    StrLen(Arg0) = 1;
  1284.    Return;
  1285.    }
  1286.  
  1287. /*
  1288.  * kbhit() -- Check to see if there is a keyboard character waiting to
  1289.  *  be read.
  1290.  */
  1291.  
  1292. FncDcl(kbhit,0)
  1293.    {
  1294.    if (kbhit()) {
  1295.       Arg0 = nulldesc;
  1296.       Return;
  1297.       }
  1298.    else Fail;
  1299.    }
  1300. #endif                    /* KeyboardFncs */
  1301.